Main figures and analyses for the manuscript
2023-08-03
- Packages and functions
- Get data
- Estimate indicators
- Change country name to nicer labels
- Simplify combinations of methods to define populations
- Averaging multiassessments
- General description of records and taxa assessed by country
- Population size data (Has Nc or Ne? what type of Nc?)
- Missing data on extant and extinct populations
- Distribution of Nc, Ne, types of Nc and missing extinct pops in a single figure with 4 panels:
- Method to define populations used by country (alluvial)
- Effect
of method used to define populations on number of populations and
Proportion of maintained populations (indicator)
- Plot Number of maintained populations by country and method
- (a) Does the number of maintained pops vary with method used?
- (b) Does the proportion of maintained populations (indicator2) vary with method used?
- (c) Is there a relationship between number of maintained populations and Indicator2, overall, and/or with some methods?
- Single plot 3 panels for the effect of method to define populations on Proportion of maintained populations (indicator) and number of pops
- Indicator 1 and indicator 2 by type of range
- Indicator 1 and Indicator 2 by IUCN status
- Values of indicator 1 and indicator 2 for multiassessed species
- Indicator 3 (number of species with genetic diversity monitoring)
This notebook estimates the indicators based on the raw data and
perfomrs the main analyses and figures used in the manuscript of the
multicountry paper. The input is the “clean kobo output” that was first
cleaned by 1.2_cleaning.
Packages and functions
Load required libraries:
library(tidyr)
library(dplyr)
library(readr)
library(utile.tools)
library(stringr)
library(ggplot2)
library(ggsankey)
library(alluvial)
library(viridis)
library(cowplot)
library(lme4)Load required functions. These custom fuctions are available at: https://github.com/AliciaMstt/GeneticIndicators
source("get_indicator1_data.R")
source("get_indicator2_data.R")
source("get_indicator3_data.R")
source("get_metadata.R")
source("transform_to_Ne.R")
source("estimate_indicator1.R")Other custom functions:
### not in
'%!in%' <- function(x,y)!('%in%'(x,y))
#' Duplicates data to create additional facet. Thanks to https://stackoverflow.com/questions/18933575/easily-add-an-all-facet-to-facet-wrap-in-ggplot2
#' @param df a dataframe
#' @param col the name of facet column
#'
CreateAllFacet <- function(df, col){
df$facet <- df[[col]]
temp <- df
temp$facet <- "all"
merged <-rbind(temp, df)
# ensure the facet value is a factor
merged[[col]] <- as.factor(merged[[col]])
return(merged)
}Custom colors:
## IUCN official colors
# Assuming order of levels is: "re", "cr", "en", "vu", "nt", "lc", "dd", "not_assessed", "unknown" (for regional, and w/o "re" for global). Make sure to change the levels to that order before plotting.
IUCNcolors<-c("brown2", "darkorange", "yellow", "green", "darkgreen", "darkgrey", "azure2", "bisque1")
IUCNcolors_regional<-c("darkorchid2", "brown2", "darkorange", "yellow", "green", "darkgreen", "darkgrey", "azure2", "bisque1")
## nice soft ramp for taxonomic groups
taxoncolors<-cividis(12) # same than using cividis(length(levels(as.factor(metadata$taxonomic_group))))
## Colors for simplified methods to define populations
# assuming the levels (see how this was created in the section "Simplify combinations of methods to define populations"): of running levels(as.factor(ind2_data$defined_populations_simplified)) (after new order)
# get a set of colors to highlight genetic and geographic with similar colors
simplifiedmethods_colors<-c("#b34656", #"adaptive_traits management_units"
"#b34656", # "management_units"
"#FFA07A", #"dispersal_buffer"
"#7f611b", # "eco_biogeo_proxies"
"#668cd1", # "genetic_clusters"
"#668cd1", # "genetic_clusters eco_biogeo_proxies"
"#45c097", # "genetic_clusters geographic_boundaries"
"#d4b43e", # "geographic_boundaries"
"#d4b43e", # "geographic_boundaries adaptive_traits"
"#d4b43e", # "geographic_boundaries eco_biogeo_proxies"
"#d4b43e", # "geographic_boundaries management_units"
"#be72c9", # "low_freq_combinations"
"#be72c9")# "other" Get data
Get indicators and metadata data from clean kobo output
# Get data:
kobo_clean<-read.csv(file="kobo_output_clean.csv", header=TRUE)
# Extract indicator 1 data from kobo output, show most relevant columns
ind1_data<-get_indicator1_data(kobo_output=kobo_clean)## [1] "the data already contained a taxon column, that was used instead of creating a new one"head(ind1_data[,c(1:3, 12:14)])# Extract Proportion of maintained populations (indicator) data from kobo output, show most relevant columns
ind2_data<-get_indicator2_data(kobo_output=kobo_clean)## [1] "the data already contained a taxon column, that was used instead of creating a new one"head(ind2_data[,c(1:3, 9:10,13)])# Extract indicator 3 data from kobo output, show most relevant columns
ind3_data<-get_indicator3_data(kobo_output=kobo_clean)## [1] "the data already contained a taxon column, that was used instead of creating a new one"head(ind3_data[,c(1:3, 9:11)])# extract metadata, show most relevant columns
metadata<-get_metadata(kobo_output=kobo_clean)## [1] "the data already contained a taxon column, that was used instead of creating a new one"head(metadata[,c(1:3, 12, 25,26, 64)])Get population data for those species assessed using the tabular text
template instead of Kobo. This file was produced by the script
1.2_cleaning.Rmd
ind1_data_from_templates<-read.csv(file="ind1_data_from_templates.csv")Add data recorded using the population template to the ind1_data already in the nice format.
ind1_data<-rbind(ind1_data, ind1_data_from_templates)Estimate indicators
Indicator 1 (proportion of populations with Ne >500):
Show most relevant columns of indicator 1 data
head(ind1_data[,c(1:3, 12:14)])Remember what the function to transform NcRange and NcPoint data into Ne does:
# check what the custom funciton does
transform_to_Ne## function (ind1_data)
## {
## ind1_data = ind1_data
## ind1_data <- ind1_data %>% mutate(Nc_from_range = case_when(NcRange ==
## "more_5000_bymuch" ~ 5001, NcRange == "more_5000" ~ 5001,
## NcRange == "less_5000_bymuch" ~ 100, NcRange == "less_5000" ~
## 100, NcRange == "range_includes_5000" ~ 5001)) %>%
## mutate(Ne_from_Nc = case_when(!is.na(NcPoint) ~ NcPoint *
## 0.1, !is.na(Nc_from_range) ~ Nc_from_range * 0.1)) %>%
## mutate(Ne_combined = if_else(is.na(Ne), Ne_from_Nc, Ne))
## print(ind1_data)
## }Use function to get Ne data from NcRange or NcPoint data, and their combination (Ne estimated from Ne if Ne is available, otherwise, from Nc)
ind1_data<-transform_to_Ne(ind1_data = ind1_data)## # A tibble: 4,567 × 38
## country_assessme… taxonomic_group taxon scientific_auth… genus year_assesment
## <chr> <chr> <chr> <chr> <chr> <chr>
## 1 sweden mammal Alce… (Linnaeus, 1758) Alces 2023
## 2 sweden mammal Alce… (Linnaeus, 1758) Alces 2023
## 3 sweden mammal Alce… (Linnaeus, 1758) Alces 2023
## 4 sweden fish Silu… (Linnaeus, 1758) Silu… 2023
## 5 sweden fish Silu… (Linnaeus, 1758) Silu… 2023
## 6 sweden fish Silu… (Linnaeus, 1758) Silu… 2023
## 7 sweden fish Silu… (Linnaeus, 1758) Silu… 2023
## 8 sweden fish Silu… (Linnaeus, 1758) Silu… 2023
## 9 sweden fish Silu… (Linnaeus, 1758) Silu… 2023
## 10 sweden bird Dend… Bechstein 1803 Dend… 2022
## # … with 4,557 more rows, and 32 more variables: name_assessor <chr>,
## # email_assessor <chr>, kobo_tabular <chr>, time_populations <chr>,
## # X_validation_status <chr>, X_uuid <chr>, multiassessment <chr>,
## # population <chr>, Name <chr>, Origin <chr>, IntroductionYear <chr>,
## # Ne <dbl>, NeLower <dbl>, NeUpper <dbl>, NeYear <chr>, GeneticMarkers <chr>,
## # GeneticMarkersOther <chr>, MethodNe <chr>, SourceNe <chr>, NcType <chr>,
## # NcYear <chr>, NcMethod <chr>, NcRange <chr>, NcRangeDetails <chr>, …Remember what the function to estimate indicator 1 does:
# check what the custom function does
estimate_indicator1## function (ind1_data)
## {
## indicator1 <- ind1_data %>% group_by(X_uuid, ) %>% summarise(n_pops = n(),
## n_pops_Ne_data = sum(!is.na(Ne_combined)), n_pops_more_500 = sum(Ne_combined >
## 500, na.rm = TRUE), indicator1 = n_pops_more_500/n_pops_Ne_data) %>%
## left_join(metadata)
## print(indicator1)
## }Now estimate indicator 1 :)
indicator1<-estimate_indicator1(ind1_data = ind1_data)## Joining, by = "X_uuid"## # A tibble: 593 × 69
## X_uuid n_pops n_pops_Ne_data n_pops_more_500 indicator1 country_assessm…
## <chr> <int> <int> <int> <dbl> <chr>
## 1 010d85cd-5… 2 1 1 1 united_states
## 2 016d59ae-9… 1 1 0 0 mexico
## 3 017ff4b6-5… 1 0 0 NaN colombia
## 4 018d6a54-b… 47 46 0 0 united_states
## 5 019bd95f-b… 1 1 0 0 sweden
## 6 01b10b29-9… 1 1 1 1 south_africa
## 7 0301e6b3-b… 3 3 3 1 france
## 8 036baa83-5… 1 0 0 NaN colombia
## 9 037a15b2-f… 3 2 0 0 colombia
## 10 037d6c8f-7… 4 2 2 1 united_states
## # … with 583 more rows, and 63 more variables: taxonomic_group <chr>,
## # taxon <chr>, scientific_authority <chr>, genus <chr>, year_assesment <chr>,
## # name_assessor <chr>, email_assessor <chr>, common_name <chr>,
## # kobo_tabular <chr>, X_validation_status <chr>, GBIF_taxonID <int>,
## # NCBI_taxonID <chr>, national_taxonID <chr>, source_national_taxonID <chr>,
## # other_populations <chr>, time_populations <chr>, defined_populations <chr>,
## # source_definition_populations <chr>, map_populations <chr>, …Proportion of maintained populations (indicator 2) = proportion of populations within species which are maintained.
Proportion of maintained populations (indicator) is the he proportion
of populations within species which are maintained. This can be
estimated based on the n_extant_populations and
n_extint_populations, as follows:
ind2_data$indicator2<- ind2_data$n_extant_populations / (ind2_data$n_extant_populations + ind2_data$n_extint_populations)
head(ind2_data$indicator2)## [1] 1.0000000 0.5000000 0.2941176 1.0000000 0.3333333 1.0000000Number of taxa with genetic monitoring squemes (indicator3)
Indicator 3 refers to the number (count) of taxa by country in which
genetic monitoring is occurring. This is stored in the variable
temp_gen_monitoring as a “yes/no” answer for each taxon, so
to estimate the indicator, we only need to count how many said “yes”,
keeping only one of the records when the taxon was multiassessed:
indicator3<-ind3_data %>%
# keep only one record if the taxon was assessed more than once within the country
select(country_assessment, taxon, temp_gen_monitoring) %>%
filter(!duplicated(.)) %>%
# count "yes" in tem_gen_monitoring by country
filter(temp_gen_monitoring=="yes") %>%
group_by(country_assessment) %>%
summarise(n_taxon_gen_monitoring= n())Join indicators and metadata in a single table
It could be useful to have the estimated indicator and the metadata in a single large table.
indicators_full<-left_join(metadata, indicator1) %>%
left_join(ind2_data) %>%
left_join(ind3_data)## Joining, by = c("country_assessment", "taxonomic_group", "taxon",
## "scientific_authority", "genus", "year_assesment", "name_assessor",
## "email_assessor", "common_name", "kobo_tabular", "X_validation_status",
## "X_uuid", "GBIF_taxonID", "NCBI_taxonID", "national_taxonID",
## "source_national_taxonID", "other_populations", "time_populations",
## "defined_populations", "source_definition_populations", "map_populations",
## "map_populations_URL", "habitat_decline_area", "source_populations",
## "popsize_data", "ne_pops_exists", "nc_pops_exists", "ratio_exists",
## "species_related", "ratio_species_related", "ratio_year",
## "source_popsize_ratios", "species_comments", "realm", "IUCN_habitat",
## "other_habitat", "national_endemic", "transboundary_type", "other_explain",
## "country_proportion", "species_range", "rarity", "occurrence_extent",
## "occurrence_area", "pop_fragmentation_level", "species_range_comments",
## "global_IUCN", "regional_redlist", "other_assessment_status",
## "other_assessment_name", "source_status_distribution", "fecundity",
## "semelparous_offpring", "reproductive_strategy", "reproductive_strategy_other",
## "adult_age_data", "other_reproductive_strategy", "longevity_max",
## "longevity_median", "longevity_maturity", "longevity_age",
## "life_history_based_on", "life_history_sp_basedon", "sources_life_history",
## "multiassessment")
## Joining, by = c("country_assessment", "taxonomic_group", "taxon",
## "scientific_authority", "genus", "year_assesment", "name_assessor",
## "email_assessor", "X_validation_status", "X_uuid", "other_populations",
## "time_populations", "defined_populations", "source_definition_populations",
## "map_populations", "map_populations_URL", "habitat_decline_area",
## "source_populations", "multiassessment")
## Joining, by = c("country_assessment", "taxonomic_group", "taxon",
## "scientific_authority", "genus", "year_assesment", "name_assessor",
## "email_assessor", "X_validation_status", "X_uuid", "multiassessment")Save indicators data
Save indicators data and metadata to csv files, useful for analyses outside R.
# save processed data
write.csv(ind1_data, "ind1_data.csv", row.names = FALSE)
write.csv(indicators_full, "indicators_full.csv", row.names = FALSE)
write.csv(ind2_data, "ind2_data.csv", row.names = FALSE)
write.csv(ind3_data, "ind3_data.csv", row.names = FALSE)
write.csv(metadata, "metadata.csv", row.names = FALSE)Change country name to nicer labels
To have nice levels in the plots we will change the way country names are written:
# make factor
metadata$country_assessment<-as.factor(metadata$country_assessment)
indicators_full$country_assessment<-as.factor(indicators_full$country_assessment)
ind2_data$country_assessment<-as.factor(ind2_data$country_assessment)
ind1_data$country_assessment<-as.factor(ind1_data$country_assessment)
indicator1$country_assessment<-as.factor(indicator1$country_assessment)
# original levels
levels(metadata$country_assessment)## [1] "australia" "belgium" "colombia" "france"
## [5] "japan" "mexico" "south_africa" "sweden"
## [9] "united_states"# change
levels(metadata$country_assessment)<-c("Australia", "Belgium", "Colombia", "France", "Japan", "Mexico", "S. Africa", "Sweden", "US")
levels(indicators_full$country_assessment)<-c("Australia", "Belgium", "Colombia", "France", "Japan", "Mexico", "S. Africa", "Sweden", "US")
levels(ind1_data$country_assessment)<-c("Australia", "Belgium", "Colombia", "France", "Japan", "Mexico", "S. Africa", "Sweden", "US")
levels(ind2_data$country_assessment)<-c("Australia", "Belgium", "Colombia", "France", "Japan", "Mexico", "S. Africa", "Sweden", "US")
levels(indicator1$country_assessment)<-c("Australia", "Belgium", "Colombia", "France", "Japan", "Mexico", "S. Africa", "Sweden", "US")Simplify combinations of methods to define populations
The methods used to define populations come from a check box question were one or more of the following categories can be selected: genetic_clusters, geographic_boundaries, eco_biogeo_proxies, adaptive_traits, management_units, other. As a consequence any combination of the former can be possible. Leading to the following frequency table:
table(ind2_data$defined_populations)##
## adaptive_traits
## 5
## adaptive_traits management_units
## 20
## dispersal_buffer
## 102
## dispersal_buffer other
## 1
## eco_biogeo_proxies
## 41
## eco_biogeo_proxies adaptive_traits
## 3
## eco_biogeo_proxies dispersal_buffer
## 7
## eco_biogeo_proxies management_units
## 3
## eco_biogeo_proxies other
## 2
## genetic_clusters
## 107
## genetic_clusters adaptive_traits
## 7
## genetic_clusters dispersal_buffer
## 6
## genetic_clusters eco_biogeo_proxies
## 20
## genetic_clusters eco_biogeo_proxies adaptive_traits
## 3
## genetic_clusters eco_biogeo_proxies adaptive_traits management_units
## 2
## genetic_clusters eco_biogeo_proxies management_units
## 1
## genetic_clusters geographic_boundaries
## 74
## genetic_clusters geographic_boundaries adaptive_traits
## 5
## genetic_clusters geographic_boundaries eco_biogeo_proxies
## 8
## genetic_clusters geographic_boundaries eco_biogeo_proxies adaptive_traits
## 1
## genetic_clusters geographic_boundaries eco_biogeo_proxies adaptive_traits management_units
## 1
## genetic_clusters geographic_boundaries eco_biogeo_proxies management_units
## 1
## genetic_clusters geographic_boundaries management_units
## 8
## genetic_clusters management_units
## 5
## genetic_clusters other
## 2
## geographic_boundaries
## 276
## geographic_boundaries adaptive_traits
## 32
## geographic_boundaries adaptive_traits management_units
## 12
## geographic_boundaries adaptive_traits management_units other
## 1
## geographic_boundaries dispersal_buffer
## 1
## geographic_boundaries eco_biogeo_proxies
## 106
## geographic_boundaries eco_biogeo_proxies adaptive_traits
## 3
## geographic_boundaries eco_biogeo_proxies management_units
## 3
## geographic_boundaries eco_biogeo_proxies other
## 2
## geographic_boundaries management_units
## 24
## geographic_boundaries other
## 12
## management_units
## 29
## management_units other
## 1
## other
## 19It is hard to group the above methods, so we will keep the original groups with n >=19 in the above list, and tag the combinations that appear few times as as “low_freq_combinations”.
Which groups have n>=19?
x<-as.data.frame(table(ind2_data$defined_populations)[table(ind2_data$defined_populations) >= 19])
colnames(x)[1]<-"method"
xWe can add this new column to the metadata and Proportion of maintained populations (indicator) data:
### for ind2_data
ind2_data<- ind2_data %>%
mutate(defined_populations_simplified = case_when(
# if the method is in the list of methods n>=19 then keep it
defined_populations %in% x$method ~ defined_populations,
TRUE ~ "low_freq_combinations"))
### for meta
metadata<- metadata %>%
mutate(defined_populations_simplified = case_when(
# if the method is in the list of methods n>=19 then keep it
defined_populations %in% x$method ~ defined_populations,
TRUE ~ "low_freq_combinations"))Check n for simplified methods:
table(ind2_data$defined_populations_simplified)##
## adaptive_traits management_units
## 20
## dispersal_buffer
## 102
## eco_biogeo_proxies
## 41
## genetic_clusters
## 107
## genetic_clusters eco_biogeo_proxies
## 20
## genetic_clusters geographic_boundaries
## 74
## geographic_boundaries
## 276
## geographic_boundaries adaptive_traits
## 32
## geographic_boundaries eco_biogeo_proxies
## 106
## geographic_boundaries management_units
## 24
## low_freq_combinations
## 106
## management_units
## 29
## other
## 19Table of equivalences:
ind2_data %>%
select(defined_populations, defined_populations_simplified) %>%
filter(!duplicated(defined_populations))Create nicer names for ploting
# original method names
levels(as.factor(ind2_data$defined_populations_simplified))## [1] "adaptive_traits management_units"
## [2] "dispersal_buffer"
## [3] "eco_biogeo_proxies"
## [4] "genetic_clusters"
## [5] "genetic_clusters eco_biogeo_proxies"
## [6] "genetic_clusters geographic_boundaries"
## [7] "geographic_boundaries"
## [8] "geographic_boundaries adaptive_traits"
## [9] "geographic_boundaries eco_biogeo_proxies"
## [10] "geographic_boundaries management_units"
## [11] "low_freq_combinations"
## [12] "management_units"
## [13] "other"# nice methods names in original order
nice_names_or <- c("adaptive traits & management units",
"dispersal buffer",
"eco- biogeographic proxies",
"genetic clusters",
"genetic clusters & eco- biogeographic proxies",
"genetic clusters & geographic boundaries",
"geographic boundaries",
"geographic boundaries & adaptive traits",
"geographic boundaries & eco- biogeographic proxies",
"geographic boundaries & management units",
"low frequency combinations",
"management units",
"others")
# nice names in better order for plotting
nice_names <- c("adaptive traits & management units",
"management units",
"dispersal buffer",
"eco- biogeographic proxies",
"genetic clusters",
"genetic clusters & eco- biogeographic proxies",
"genetic clusters & geographic boundaries",
"geographic boundaries",
"geographic boundaries & adaptive traits",
"geographic boundaries & eco- biogeographic proxies",
"geographic boundaries & management units",
"low frequency combinations",
"others")
### add them
## ind2
ind2_data$defined_populations_nicenames<-as.factor(ind2_data$defined_populations_simplified)
# add new nice names
levels(ind2_data$defined_populations_nicenames)<-nice_names_or
# change to desired order
ind2_data$defined_populations_nicenames<-factor(ind2_data$defined_populations_nicenames,
levels=nice_names)
# metadata
metadata$defined_populations_nicenames<-as.factor(metadata$defined_populations_simplified)
levels(metadata$defined_populations_nicenames)<-nice_names_or
metadata$defined_populations_nicenames<-factor(metadata$defined_populations_nicenames,
levels=nice_names)
#check names match
select(metadata, defined_populations_nicenames, defined_populations_simplified)Averaging multiassessments
Some taxa were assessed twice or more times, for example to account
for uncertainty on how to divide populations. This information is stored
in variable multiassessment of the metadata (created by
get_metadata()). An example of taxa with multiple
assessments:
metadata %>%
filter(multiassessment=="multiassessment") %>%
select(taxonomic_group, taxon, country_assessment, multiassessment) %>%
arrange(taxon, country_assessment) %>%
head()Multiassessments allow to account for uncertainty in the number of populations or the size of them. We can examine how the indicators value species by species as done elsewhere in these analyses (see below “Values for indicator 1 and 2 for multiassessed species), but to examine global trends, some of the figures below use the average.
indicators_averaged<-indicators_full %>%
# group desired multiassessments
group_by(country_assessment, multiassessment, taxon) %>%
# estimate means
mutate(indicator1_mean=mean(indicator1, na.rm=TRUE)) %>%
mutate(indicator2_mean=mean(indicator2, na.rm=TRUE)) %>%
# change NaN for NA (needed due to the NAs and 0s in the dataset)
mutate_all(~ifelse(is.nan(.), NA, .)) ## `mutate_all()` ignored the following grouping variables:
## • Columns `country_assessment`, `multiassessment`, `taxon`
## ℹ Use `mutate_at(df, vars(-group_cols()), myoperation)` to silence the message.Examples of how this looks to check it was done properly. For indicator 1:
indicators_averaged %>%
filter(taxon == "Barbastella barbastellus") %>%
select(taxon, country_assessment, multiassessment, indicator1, indicator1_mean)indicators_averaged %>%
filter(taxon == "Rana dalmatina") %>%
select(taxon, country_assessment, multiassessment, indicator1, indicator1_mean)indicators_averaged %>%
filter(taxon == "Ambystoma cingulatum") %>%
select(taxon, country_assessment, multiassessment, indicator1, indicator1_mean)For Proportion of maintained populations (indicator):
indicators_averaged %>%
filter(taxon == "Ambystoma cingulatum") %>%
select(taxon, country_assessment, multiassessment, indicator2, indicator2_mean)Because we will use the averages to show a single value for multiasssessed taxa, we can keep only the first record for multiassessed taxa.
indicators_averaged_one<-indicators_averaged[!duplicated(cbind(indicators_averaged$taxon, indicators_averaged$country_assessment)), ]General description of records and taxa assessed by country
Records by country, including taxa assessed more than once (see below for details on this)
ggplot(metadata, aes(x=country_assessment)) +
geom_bar(stat = "count") +
xlab("") +
ggtitle("Number of taxa assessed by country, including taxa assed more than once") +
theme_light()
To explore what kind of taxa countries assessed regardless of if they
assessed them once or more, we are going to use the subset
indicators_averaged_one, were we averaged the indicators
and kept only 1 record per assessment.
How many taxa were assessed (i.e. counting only once taxa that were assessed multiple times)?
# how many?
nrow(indicators_averaged_one)## [1] 909Plot taxa assessed excluding duplicates, i.e. the real number of taxa assessed:
ggplot(indicators_averaged_one, aes(x=country_assessment)) +
geom_bar(stat = "count") +
xlab("") +
ggtitle("Number of taxa assessed by country") +
theme_light()
Of which countries and taxonomic groups are the taxa that were assessed more than once?
indicators_averaged_one %>% # we use the _unique dataset so that multiassesed records are counted only once
filter(multiassessment=="multiassessment") %>%
ggplot(aes(x=taxonomic_group, fill=country_assessment)) +
geom_bar(stat = "count") +
theme(axis.text.x = element_text(angle = 45)) +
labs(fill="Country") +
xlab("") +
ggtitle("Number of taxa assessed more than once") +
theme_light()
Population size data (Has Nc or Ne? what type of Nc?)
Population size data availability by country
Countries have population size data (Nc or Ne) regardless of the taxonomic group.
ggplot(metadata, aes(x=taxonomic_group, fill=popsize_data)) +
geom_bar(stat = "count") +
coord_flip() +
facet_wrap(~country_assessment, ncol = 5) +
scale_fill_manual(values=c("#2ca02c", "#1f77b4", "grey80"),
breaks=c("yes", "data_for_species", "insuff_data_species"),
labels=c("Population level", "Species or subspecies level", "Insufficient data")) +
labs(fill="Population size data availability",
x="",
y="Number of taxa (including records of taxa assessed more than once)") +
theme_light() +
theme(panel.border = element_blank(), legend.position="top")
Same plot but including a panel for the entire dataset:
## Duplicate data with an additional column "facet"
df<-CreateAllFacet(metadata, "country_assessment")
# order with "all" as last
df$facet <- factor(df$facet, levels=c("Australia", "Belgium", "Colombia", "France", "Japan", "Mexico", "S. Africa", "Sweden", "US", "all"))
# Plot
ggplot(df, aes(x=taxonomic_group, fill=popsize_data)) +
geom_bar(stat = "count") +
coord_flip() +
facet_wrap(~facet, ncol = 5, scales="free_x") +
scale_fill_manual(values=c("#2ca02c", "#1f77b4", "grey80"),
breaks=c("yes", "data_for_species", "insuff_data_species"),
labels=c("Population level", "Species or subspecies level", "Insufficient data")) + labs(fill="Population size data availability",
x="",
y="Number of taxa (including records of taxa assessed more than once)") +
theme_light() +
theme(panel.border = element_blank(), legend.position="top")
Population size data availability in the entire dataset:
ggplot(metadata, aes(x=taxonomic_group, fill=popsize_data)) +
geom_bar(stat = "count") +
coord_flip() +
scale_fill_manual(values=c("#1f77b4", "grey80", "#2ca02c"),
breaks=c(levels(as.factor(metadata$popsize_data))),
labels=c("Species level or subspecies level", "Insufficient data", "Population level")) +
labs(fill="Population size data availability",
x="",
y="Number of taxa (including records of taxa assessed more than once)") +
theme_light() +
theme(legend.position="right")
Ne data yes or not? & Type of Nc data
Ne available by taxa?
p1<- metadata %>%
filter(!is.na(ne_pops_exists)) %>%
filter(ne_pops_exists!="other_genetic_info") %>%
ggplot(aes(x=country_assessment, fill=ne_pops_exists)) +
geom_bar() +
scale_fill_manual(labels=c("no", "yes"),
breaks=c("no_genetic_data", "ne_available"),
values=c("#ff7f0e", "#2ca02c")) +
xlab("") +
ylab("Number of taxa") +
labs(fill="Ne available \n(from genetic data)") +
theme_light() +
theme(text = element_text(size = 13), legend.position = "right", panel.border = element_blank())
p1
Nc data available by taxa?
p2<-metadata %>%
filter(!is.na(nc_pops_exists)) %>%
ggplot(aes(x=country_assessment, fill=nc_pops_exists)) +
geom_bar() +
scale_fill_manual(values=c("#ff7f0e", "#2ca02c")) +
labs(fill="Nc available") +
xlab("") +
ylab("Number of taxa") +
theme_light() +
theme(text = element_text(size = 13), legend.position = "right", panel.border = element_blank())
p2
What kind of Nc data? (dodge bars)
ind1_data %>%
filter(!is.na(NcType)) %>%
ggplot(aes(x=country_assessment, fill=NcType))+
geom_bar(position = "dodge") +
scale_fill_manual(labels=c("Point", "Range \nor qualitative", "Unknown"),
breaks=c("Nc_point", "Nc_range", "unknown"),
values=c("#0072B2", "#E69F00", "grey80")) +
xlab("") +
ylab("Number of populations") +
labs(fill="Type of Nc data \nby population") +
theme_light() +
theme(text = element_text(size = 13), legend.position = "right", panel.border = element_blank())
What kind of Nc data? (fill bars)
p3<-ind1_data %>%
filter(!is.na(NcType)) %>%
ggplot(aes(x=country_assessment, fill=NcType))+
geom_bar(position = "fill") +
scale_fill_manual(labels=c("Point", "Range \nor qualitative", "Unknown"),
breaks=c("Nc_point", "Nc_range", "unknown"),
values=c("#0072B2", "#E69F00", "grey80")) +
xlab("") +
ylab("Proportion of populations") +
labs(fill="Type of Nc data \nby population") +
theme_light() +
theme(text = element_text(size = 13), legend.position = "right", panel.border = element_blank())
p3
Missing data on extant and extinct populations
We have NA in Proportion of maintained populations (indicator) because in some cases the number of extinct populations is unknown, therefore the operation cannot be computed.
Counts
Total records with NA in extant populations:
sum(is.na(ind2_data$n_extant_populations))## [1] 19Taxa with NA in extant populations:
ind2_data %>%
filter(is.na(n_extant_populations)) %>%
select(country_assessment, taxonomic_group, taxon, n_extant_populations, n_extint_populations)Total taxa with NA in extinct populations:
sum(is.na(ind2_data$n_extint_populations))## [1] 378Do taxa with NA for extant also have NA for extinct?
ind2_data$taxon[is.na(ind2_data$n_extant_populations)] %in% ind2_data$taxon[is.na(ind2_data$n_extint_populations)]## [1] TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE TRUE
## [16] TRUE TRUE TRUE TRUESo out of the 956, we have 378 records with NA in n_extinct and 19 records with NA in n_extant. Of them, 19 have NA in both n_extant and n_extinct.
Plot missing data extinct populations
p4<-ind2_data %>%
ggplot(aes(x=country_assessment, fill=is.na(n_extint_populations))) +
geom_bar() +
scale_fill_manual(labels=c("number of populations known", "missing data"),
values=c("#2ca02c", "#ff7f0e")) +
labs(fill="Extinct populations") +
xlab("") + ylab("Number of taxa") +
theme_light() +
theme(text = element_text(size = 13), legend.position = "right", panel.border = element_blank())
p4
Plot missing data extinct populations by country
Missing data in number of extinct populations by method to define populations:
ind2_data %>%
ggplot(aes(x=defined_populations_nicenames, fill=is.na(n_extint_populations)))+
geom_bar() +
coord_flip()+
scale_fill_manual(labels=c("number of populations known", "missing data"),
values=c("#2ca02c", "#ff7f0e")) +
labs(fill="Extinct populations") +
xlab("") + ylab("Number of taxa") +
facet_wrap(country_assessment ~., nrow = 3, scales="free_x") +
theme_light() +
theme(panel.border = element_blank(), legend.position="top")
Distribution of Nc, Ne, types of Nc and missing extinct pops in a single figure with 4 panels:
Distribution of Nc, Ne and types of Ne in a single figure with 3 panels, using count for a & b, and proportions for c:
# plot
plot_grid(p1 + theme(legend.justification = c(0,.5)), # legend.justification aligns legends
p2 + theme(legend.justification = c(0,.5)),
p3 + theme(legend.justification = c(0,.5)),
p4 + theme(legend.justification = c(0,.5)),
ncol=1, rel_widths = c(1,1,1,1), align = "v", labels=c("a)", "b)", "c)", "d)"), vjust = .7) 
Method to define populations used by country (alluvial)
Reformat data
select(metadata, defined_populations_nicenames, defined_populations_simplified)# reformat data
foralluvial<-metadata %>% group_by(country_assessment, defined_populations_nicenames, taxonomic_group) %>%
summarise(n=n()) ## `summarise()` has grouped output by 'country_assessment',
## 'defined_populations_nicenames'. You can override using the `.groups` argument.# define colors
my_cols<- simplifiedmethods_colors
# we need a vector of colors by country for each row of the dataset, so:
methodspop<-as.factor(foralluvial$defined_populations_nicenames)
levels(methodspop)<-my_cols
methodspop<-as.vector(methodspop)
head(methodspop)## [1] "#b34656" "#668cd1" "#668cd1" "#668cd1" "#668cd1" "#668cd1"Plot
# plot
alluvial(foralluvial[,1:3], freq = foralluvial$n,
col=methodspop,
blocks=FALSE,
gap.width = 0.5,
cex=.8,
xw = 0.1,
cw = 0.2,
border = NA,
alpha = .7)
Effect of method used to define populations on number of populations and Proportion of maintained populations (indicator)
The analyses and plots below us a subset of data filtering outliers (>500 populations) and using the simplified methods (see above). Multiassessed species are considered independently (each assessment is a data point).
Plot Number of maintained populations by country and method
ind2_data %>%
filter(n_extant_populations<500) %>% # filter outliers
# order countries vertically by similar number of pops
mutate(country_assessment = factor(country_assessment,
levels=c("Colombia", "Australia", "Belgium",
"Mexico", "France", "US",
"S. Africa", "Japan", "Sweden"))) %>%
ggplot(aes(x=defined_populations_nicenames, y=n_extant_populations,
fill=defined_populations_nicenames, color=defined_populations_nicenames)) +
geom_boxplot() +
geom_jitter(size=.3, width = 0.1, color="black") +
coord_flip() +
facet_wrap(country_assessment ~ ., nrow=3, scales="free_x") +
xlab("") +
ylab("Number of maintained populations") +
scale_fill_manual(values=alpha(simplifiedmethods_colors, .3),
breaks=levels(as.factor(ind2_data$defined_populations_nicenames))) +
scale_color_manual(values=simplifiedmethods_colors,
breaks=levels(as.factor(ind2_data$defined_populations_nicenames))) +
scale_x_discrete(limits=rev) +
theme_light() +
theme(panel.border = element_blank(), legend.position="none",
text = element_text(size = 15)) 
levels(ind2_data$country_assessment)## [1] "Australia" "Belgium" "Colombia" "France" "Japan" "Mexico"
## [7] "S. Africa" "Sweden" "US"(a) Does the number of maintained pops vary with method used?
Plot number of populations by method
# Prepare data for plot with nice labels:
# sample size of TOTAL populations
sample_size <- ind2_data %>%
filter(!is.na(n_extant_populations)) %>%
filter(n_extant_populations<500) %>%
group_by(defined_populations_nicenames) %>% summarize(num=n())
# custom axis
## new dataframe
df<-ind2_data %>%
filter(!is.na(n_extant_populations)) %>%
filter(n_extant_populations<500) %>%
# add sampling size
left_join(sample_size) %>%
mutate(myaxis = paste0(defined_populations_nicenames, " (n= ", num, ")")) %>%
#myaxis needs levels in the same order than defined_populations_nicenames
mutate(myaxis = factor(myaxis,
levels=levels(as.factor(myaxis))[c(1,11,2:10,12)])) # reorders levels## Joining, by = "defined_populations_nicenames"# plot for number of pops
p1<- df %>%
ggplot(aes(x=myaxis, y=n_extant_populations, color=defined_populations_nicenames,
fill=defined_populations_nicenames)) +
geom_boxplot() + xlab("") + ylab("Number of maintained populations") +
geom_jitter(size=.4, width = 0.1, color="black") +
coord_flip() +
theme_light() +
theme(panel.border = element_blank(), legend.position="none",
plot.margin = unit(c(0, 0, 0, 0), "cm")) + # this is used to decrease the space between plots
scale_color_manual(values=simplifiedmethods_colors,
breaks=levels(as.factor(ind2_data$defined_populations_nicenames))) +
scale_fill_manual(values=alpha(simplifiedmethods_colors, 0.3),
breaks=levels(as.factor(ind2_data$defined_populations_nicenames))) +
scale_x_discrete(limits=rev) +
theme(text = element_text(size = 13))
p1
Prepare data for model (remove outliers and NA in desired variable) and check n:
# remove missing data
data_for_model<-ind2_data %>%
filter(!is.na(n_extant_populations)) %>%
filter(n_extant_populations<500) # doesn't make a difference in the test below, but useful for plots
# check n per method
table(data_for_model$defined_populations_simplified)##
## adaptive_traits management_units
## 19
## dispersal_buffer
## 97
## eco_biogeo_proxies
## 41
## genetic_clusters
## 105
## genetic_clusters eco_biogeo_proxies
## 19
## genetic_clusters geographic_boundaries
## 74
## geographic_boundaries
## 272
## geographic_boundaries adaptive_traits
## 32
## geographic_boundaries eco_biogeo_proxies
## 105
## geographic_boundaries management_units
## 24
## low_freq_combinations
## 104
## management_units
## 29
## other
## 14# total n
nrow(data_for_model)## [1] 935Run model asking: Does the number of maintained pops vary with method used? Test controlling for variation in the number of maintaiend populations among countries:
m1<-glmer(data_for_model$n_extant_populations ~ data_for_model$defined_populations_simplified +
(1|data_for_model$country_assessment), family ="poisson")See results:
summary(m1)## Generalized linear mixed model fit by maximum likelihood (Laplace
## Approximation) [glmerMod]
## Family: poisson ( log )
## Formula:
## data_for_model$n_extant_populations ~ data_for_model$defined_populations_simplified +
## (1 | data_for_model$country_assessment)
##
## AIC BIC logLik deviance df.resid
## 26925.3 26993.1 -13448.7 26897.3 921
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -6.021 -2.809 -1.281 0.252 78.588
##
## Random effects:
## Groups Name Variance Std.Dev.
## data_for_model$country_assessment (Intercept) 1.106 1.052
## Number of obs: 935, groups: data_for_model$country_assessment, 9
##
## Fixed effects:
## Estimate
## (Intercept) 1.00181
## data_for_model$defined_populations_simplifieddispersal_buffer 0.05688
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies 1.53549
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.13757
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 0.32959
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries 1.59524
## data_for_model$defined_populations_simplifiedgeographic_boundaries 1.27647
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.82525
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies 1.49368
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 1.33525
## data_for_model$defined_populations_simplifiedlow_freq_combinations 0.73440
## data_for_model$defined_populations_simplifiedmanagement_units 0.95892
## data_for_model$defined_populations_simplifiedother 0.22319
## Std. Error
## (Intercept) 0.37009
## data_for_model$defined_populations_simplifieddispersal_buffer 0.13321
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies 0.12676
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.13635
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 0.15362
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries 0.12645
## data_for_model$defined_populations_simplifiedgeographic_boundaries 0.12399
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.11661
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies 0.12859
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 0.13250
## data_for_model$defined_populations_simplifiedlow_freq_combinations 0.12155
## data_for_model$defined_populations_simplifiedmanagement_units 0.13366
## data_for_model$defined_populations_simplifiedother 0.16540
## z value
## (Intercept) 2.707
## data_for_model$defined_populations_simplifieddispersal_buffer 0.427
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies 12.113
## data_for_model$defined_populations_simplifiedgenetic_clusters 1.009
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 2.145
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries 12.615
## data_for_model$defined_populations_simplifiedgeographic_boundaries 10.295
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 7.077
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies 11.616
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 10.078
## data_for_model$defined_populations_simplifiedlow_freq_combinations 6.042
## data_for_model$defined_populations_simplifiedmanagement_units 7.175
## data_for_model$defined_populations_simplifiedother 1.349
## Pr(>|z|)
## (Intercept) 0.00679
## data_for_model$defined_populations_simplifieddispersal_buffer 0.66939
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies < 2e-16
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.31303
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 0.03192
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries < 2e-16
## data_for_model$defined_populations_simplifiedgeographic_boundaries < 2e-16
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 1.47e-12
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies < 2e-16
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units < 2e-16
## data_for_model$defined_populations_simplifiedlow_freq_combinations 1.52e-09
## data_for_model$defined_populations_simplifiedmanagement_units 7.25e-13
## data_for_model$defined_populations_simplifiedother 0.17721
##
## (Intercept) **
## data_for_model$defined_populations_simplifieddispersal_buffer
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies ***
## data_for_model$defined_populations_simplifiedgenetic_clusters
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies *
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries ***
## data_for_model$defined_populations_simplifiedgeographic_boundaries ***
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits ***
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies ***
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units ***
## data_for_model$defined_populations_simplifiedlow_freq_combinations ***
## data_for_model$defined_populations_simplifiedmanagement_units ***
## data_for_model$defined_populations_simplifiedother
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1##
## Correlation matrix not shown by default, as p = 13 > 12.
## Use print(x, correlation=TRUE) or
## vcov(x) if you need it(b) Does the proportion of maintained populations (indicator2) vary with method used?
Plot
# Prepare data for plot with nice labels:
# sample size of TOTAL populations
sample_size <- ind2_data %>%
filter(!is.na(indicator2)) %>%
filter(n_extant_populations<500) %>%
group_by(defined_populations_nicenames) %>% summarize(num=n())
# custom axis
## new dataframe
df<-ind2_data %>%
filter(n_extant_populations<500) %>%
filter(!is.na(indicator2)) %>%
# add sampling size
left_join(sample_size) %>%
mutate(myaxis = paste0(defined_populations_nicenames, " (n= ", num, ")")) %>%
#myaxis needs levels in the same order than defined_populations_nicenames
mutate(myaxis = factor(myaxis,
levels=levels(as.factor(myaxis))[c(1,11,2:10,12)])) # reorders levels## Joining, by = "defined_populations_nicenames"## plot for Proportion of maintained populations (indicator)
p2<- df %>%
filter(n_extant_populations<500) %>%
ggplot(aes(x=myaxis, y=indicator2, color=defined_populations_nicenames,
fill=defined_populations_nicenames)) +
geom_boxplot() + xlab("") + ylab("Proportion of maintained populations (indicator)") +
geom_jitter(size=.4, width = 0.1, color="black") +
coord_flip() +
theme_light() +
theme(panel.border = element_blank(), legend.position="none",
plot.margin = unit(c(0, 0, 0, 0), "cm")) + # this is used to decrease the space between plots)
scale_fill_manual(values=alpha(simplifiedmethods_colors, 0.3),
breaks=levels(as.factor(ind2_data$defined_populations_nicenames))) +
scale_color_manual(values=simplifiedmethods_colors,
breaks=levels(as.factor(ind2_data$defined_populations_nicenames))) +
scale_x_discrete(limits=rev) +
theme(text = element_text(size = 13))
p2
Prepare data for model (remove outliers and NA in desired variable) and check n:
# remove missing data
data_for_model<-ind2_data %>%
filter(!is.na(indicator2)) %>%
filter(n_extant_populations<500) # doesn't make a difference in the test below, but useful for plots
# check n per method
table(data_for_model$defined_populations_simplified)##
## adaptive_traits management_units
## 19
## dispersal_buffer
## 21
## eco_biogeo_proxies
## 30
## genetic_clusters
## 50
## genetic_clusters eco_biogeo_proxies
## 12
## genetic_clusters geographic_boundaries
## 46
## geographic_boundaries
## 178
## geographic_boundaries adaptive_traits
## 32
## geographic_boundaries eco_biogeo_proxies
## 69
## geographic_boundaries management_units
## 17
## low_freq_combinations
## 70
## management_units
## 23
## other
## 9# total n
nrow(data_for_model)## [1] 576Run model asking: Does indicator 2 vary with method used? Controlling for variation in indicator2 among countries:
m2<-glm(data_for_model$indicator2 ~ data_for_model$defined_populations_simplified, family ="quasibinomial")See results:
summary(m2)##
## Call:
## glm(formula = data_for_model$indicator2 ~ data_for_model$defined_populations_simplified,
## family = "quasibinomial")
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.8257 -0.2931 0.3724 0.6077 1.2874
##
## Coefficients:
## Estimate
## (Intercept) 2.626197
## data_for_model$defined_populations_simplifieddispersal_buffer -2.881139
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies -1.030556
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.019208
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies -0.355566
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries -0.693107
## data_for_model$defined_populations_simplifiedgeographic_boundaries -1.191824
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.007871
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies -1.114953
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units -0.569626
## data_for_model$defined_populations_simplifiedlow_freq_combinations -0.893717
## data_for_model$defined_populations_simplifiedmanagement_units -1.291351
## data_for_model$defined_populations_simplifiedother -1.168951
## Std. Error
## (Intercept) 0.584433
## data_for_model$defined_populations_simplifieddispersal_buffer 0.648544
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies 0.662319
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.688137
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 0.861802
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries 0.649573
## data_for_model$defined_populations_simplifiedgeographic_boundaries 0.596929
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.738748
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies 0.617677
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 0.761894
## data_for_model$defined_populations_simplifiedlow_freq_combinations 0.622290
## data_for_model$defined_populations_simplifiedmanagement_units 0.670219
## data_for_model$defined_populations_simplifiedother 0.798556
## t value
## (Intercept) 4.494
## data_for_model$defined_populations_simplifieddispersal_buffer -4.442
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies -1.556
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.028
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies -0.413
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries -1.067
## data_for_model$defined_populations_simplifiedgeographic_boundaries -1.997
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.011
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies -1.805
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units -0.748
## data_for_model$defined_populations_simplifiedlow_freq_combinations -1.436
## data_for_model$defined_populations_simplifiedmanagement_units -1.927
## data_for_model$defined_populations_simplifiedother -1.464
## Pr(>|t|)
## (Intercept) 8.50e-06
## data_for_model$defined_populations_simplifieddispersal_buffer 1.07e-05
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies 0.1203
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.9777
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 0.6801
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries 0.2864
## data_for_model$defined_populations_simplifiedgeographic_boundaries 0.0464
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.9915
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies 0.0716
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 0.4550
## data_for_model$defined_populations_simplifiedlow_freq_combinations 0.1515
## data_for_model$defined_populations_simplifiedmanagement_units 0.0545
## data_for_model$defined_populations_simplifiedother 0.1438
##
## (Intercept) ***
## data_for_model$defined_populations_simplifieddispersal_buffer ***
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies
## data_for_model$defined_populations_simplifiedgenetic_clusters
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries
## data_for_model$defined_populations_simplifiedgeographic_boundaries *
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies .
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units
## data_for_model$defined_populations_simplifiedlow_freq_combinations
## data_for_model$defined_populations_simplifiedmanagement_units .
## data_for_model$defined_populations_simplifiedother
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for quasibinomial family taken to be 0.40833)
##
## Null deviance: 250.99 on 575 degrees of freedom
## Residual deviance: 222.16 on 563 degrees of freedom
## AIC: NA
##
## Number of Fisher Scoring iterations: 5(c) Is there a relationship between number of maintained populations and Indicator2, overall, and/or with some methods?
Scatter plot of indicator2 vs extant pops
p3<- ind2_data %>%
# filter outliers with too many pops and missing data
filter(n_extant_populations<500) %>%
filter(!is.na(indicator2)) %>%
filter(!is.na(n_extant_populations)) %>%
# plot
ggplot(aes(x=n_extant_populations, y=indicator2, color=defined_populations_nicenames)) +
geom_point() +
theme_light() +
scale_color_manual(values=simplifiedmethods_colors,
breaks=levels(as.factor(ind2_data$defined_populations_nicenames))) +
theme(legend.position = "none") +
ylab("Proportion of maintained populations (indicator)") +
xlab("Number of maintained populations") +
theme(text = element_text(size = 13))
p3
Prepare data for model (remove outliers and NA in desired variable) and check n:
# remove missing data
data_for_model<-ind2_data %>%
filter(!is.na(indicator2)) %>%
filter(!is.na(n_extant_populations)) %>%
filter(n_extant_populations<500) # doesn't make a difference in the test below, but useful for plots
# check number of methods
length(unique(data_for_model$defined_populations_simplified))## [1] 13# check n per method
table(data_for_model$defined_populations_simplified)##
## adaptive_traits management_units
## 19
## dispersal_buffer
## 21
## eco_biogeo_proxies
## 30
## genetic_clusters
## 50
## genetic_clusters eco_biogeo_proxies
## 12
## genetic_clusters geographic_boundaries
## 46
## geographic_boundaries
## 178
## geographic_boundaries adaptive_traits
## 32
## geographic_boundaries eco_biogeo_proxies
## 69
## geographic_boundaries management_units
## 17
## low_freq_combinations
## 70
## management_units
## 23
## other
## 9# total n
nrow(data_for_model)## [1] 576Run GLM model including method. Note: the number of mantained populations varies a lot among countries, but it’s in the predictor here, not response, so don’t really need country as random factor.
This model will be unbalanced and it is more parametarized, but it would be the ideal if our dataset were larger:
# run model
m3 <- glm(data_for_model$indicator2 ~ data_for_model$n_extant_populations +
data_for_model$defined_populations_simplified +
data_for_model$n_extant_populations*data_for_model$defined_populations_simplified, family = "quasibinomial")Summary:
summary(m3)##
## Call:
## glm(formula = data_for_model$indicator2 ~ data_for_model$n_extant_populations +
## data_for_model$defined_populations_simplified + data_for_model$n_extant_populations *
## data_for_model$defined_populations_simplified, family = "quasibinomial")
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.0141 -0.2928 0.3621 0.5768 1.4048
##
## Coefficients:
## Estimate
## (Intercept) 2.40748
## data_for_model$n_extant_populations 0.04605
## data_for_model$defined_populations_simplifieddispersal_buffer -3.01907
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies -0.90120
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.48522
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 1.73254
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries -0.27973
## data_for_model$defined_populations_simplifiedgeographic_boundaries -1.00348
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.12491
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies -0.81498
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units -0.65696
## data_for_model$defined_populations_simplifiedlow_freq_combinations -0.68092
## data_for_model$defined_populations_simplifiedmanagement_units -0.52017
## data_for_model$defined_populations_simplifiedother -2.49424
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifieddispersal_buffer 0.04517
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedeco_biogeo_proxies -0.04288
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters -0.12867
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies -0.18537
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries -0.05244
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries -0.04408
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits -0.03108
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies -0.05127
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 0.05238
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedlow_freq_combinations -0.04541
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedmanagement_units -0.08991
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedother 0.66367
## Std. Error
## (Intercept) 0.78415
## data_for_model$n_extant_populations 0.12514
## data_for_model$defined_populations_simplifieddispersal_buffer 0.88025
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies 0.85451
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.93419
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 1.52103
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries 0.84313
## data_for_model$defined_populations_simplifiedgeographic_boundaries 0.79509
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.92561
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies 0.81116
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 1.01597
## data_for_model$defined_populations_simplifiedlow_freq_combinations 0.81927
## data_for_model$defined_populations_simplifiedmanagement_units 0.90059
## data_for_model$defined_populations_simplifiedother 1.21610
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifieddispersal_buffer 0.14543
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedeco_biogeo_proxies 0.12528
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters 0.16550
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 0.13763
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries 0.12518
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries 0.12520
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.13149
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies 0.12519
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 0.20534
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedlow_freq_combinations 0.12571
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedmanagement_units 0.12692
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedother 0.57974
## t value
## (Intercept) 3.070
## data_for_model$n_extant_populations 0.368
## data_for_model$defined_populations_simplifieddispersal_buffer -3.430
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies -1.055
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.519
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 1.139
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries -0.332
## data_for_model$defined_populations_simplifiedgeographic_boundaries -1.262
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.135
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies -1.005
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units -0.647
## data_for_model$defined_populations_simplifiedlow_freq_combinations -0.831
## data_for_model$defined_populations_simplifiedmanagement_units -0.578
## data_for_model$defined_populations_simplifiedother -2.051
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifieddispersal_buffer 0.311
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedeco_biogeo_proxies -0.342
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters -0.777
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies -1.347
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries -0.419
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries -0.352
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits -0.236
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies -0.410
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 0.255
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedlow_freq_combinations -0.361
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedmanagement_units -0.708
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedother 1.145
## Pr(>|t|)
## (Intercept) 0.002245
## data_for_model$n_extant_populations 0.713024
## data_for_model$defined_populations_simplifieddispersal_buffer 0.000649
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies 0.292057
## data_for_model$defined_populations_simplifiedgenetic_clusters 0.603691
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 0.255177
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries 0.740190
## data_for_model$defined_populations_simplifiedgeographic_boundaries 0.207451
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.892700
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies 0.315477
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 0.518137
## data_for_model$defined_populations_simplifiedlow_freq_combinations 0.406261
## data_for_model$defined_populations_simplifiedmanagement_units 0.563779
## data_for_model$defined_populations_simplifiedother 0.040738
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifieddispersal_buffer 0.756239
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedeco_biogeo_proxies 0.732274
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters 0.437214
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies 0.178574
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries 0.675417
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries 0.724931
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits 0.813250
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies 0.682283
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries management_units 0.798742
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedlow_freq_combinations 0.718075
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedmanagement_units 0.478961
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedother 0.252800
##
## (Intercept) **
## data_for_model$n_extant_populations
## data_for_model$defined_populations_simplifieddispersal_buffer ***
## data_for_model$defined_populations_simplifiedeco_biogeo_proxies
## data_for_model$defined_populations_simplifiedgenetic_clusters
## data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies
## data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries
## data_for_model$defined_populations_simplifiedgeographic_boundaries
## data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits
## data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies
## data_for_model$defined_populations_simplifiedgeographic_boundaries management_units
## data_for_model$defined_populations_simplifiedlow_freq_combinations
## data_for_model$defined_populations_simplifiedmanagement_units
## data_for_model$defined_populations_simplifiedother *
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifieddispersal_buffer
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedeco_biogeo_proxies
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters eco_biogeo_proxies
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgenetic_clusters geographic_boundaries
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries adaptive_traits
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries eco_biogeo_proxies
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedgeographic_boundaries management_units
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedlow_freq_combinations
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedmanagement_units
## data_for_model$n_extant_populations:data_for_model$defined_populations_simplifiedother
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for quasibinomial family taken to be 0.3965175)
##
## Null deviance: 250.99 on 575 degrees of freedom
## Residual deviance: 211.10 on 550 degrees of freedom
## AIC: NA
##
## Number of Fisher Scoring iterations: 7We run a similar model than above, but limited to relationship of interest: glm(indicator2 ~ N_maintained_pops, family = “quasibinomial”).
m3 <- glm(data_for_model$indicator2 ~ data_for_model$n_extant_populations, family = "quasibinomial")
m3##
## Call: glm(formula = data_for_model$indicator2 ~ data_for_model$n_extant_populations,
## family = "quasibinomial")
##
## Coefficients:
## (Intercept) data_for_model$n_extant_populations
## 1.641067 -0.002482
##
## Degrees of Freedom: 575 Total (i.e. Null); 574 Residual
## Null Deviance: 251
## Residual Deviance: 250.2 AIC: NASummary:
summary(m3)##
## Call:
## glm(formula = data_for_model$indicator2 ~ data_for_model$n_extant_populations,
## family = "quasibinomial")
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.9069 -0.3763 0.5959 0.5965 0.7434
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 1.641067 0.078343 20.947 <2e-16 ***
## data_for_model$n_extant_populations -0.002482 0.001720 -1.443 0.15
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for quasibinomial family taken to be 0.4378223)
##
## Null deviance: 250.99 on 575 degrees of freedom
## Residual deviance: 250.15 on 574 degrees of freedom
## AIC: NA
##
## Number of Fisher Scoring iterations: 4Because “what’s a population and how do you define them?” is such an important question, we can also test the effect of methods alone. First, subset the data to only those taxa where a single method was used:
ind2_single_methods<-ind2_data %>%
filter(!is.na(indicator2)) %>%
filter(n_extant_populations<500) %>% # doesn't make a difference in the test below, but useful for
filter(defined_populations_simplified=="genetic_clusters" |
defined_populations_simplified=="geographic_boundaries" |
defined_populations_simplified=="eco_biogeo_proxies" |
defined_populations_simplified=="management_units")
# check number of methods
length(unique(ind2_single_methods$defined_populations_simplified))## [1] 4# check n by method
table(ind2_single_methods$defined_populations_simplified)##
## eco_biogeo_proxies genetic_clusters geographic_boundaries
## 30 50 178
## management_units
## 23# check n total
nrow(ind2_single_methods)## [1] 281Run model:
# run model
m4 <- glm(ind2_single_methods$indicator2 ~ ind2_single_methods$n_extant_populations +
ind2_single_methods$defined_populations_simplified +
ind2_single_methods$n_extant_populations*ind2_single_methods$defined_populations_simplified, family = "quasibinomial")Summary:
summary(m4)##
## Call:
## glm(formula = ind2_single_methods$indicator2 ~ ind2_single_methods$n_extant_populations +
## ind2_single_methods$defined_populations_simplified + ind2_single_methods$n_extant_populations *
## ind2_single_methods$defined_populations_simplified, family = "quasibinomial")
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.0141 -0.3214 0.3419 0.6581 0.6757
##
## Coefficients:
## Estimate
## (Intercept) 1.506282
## ind2_single_methods$n_extant_populations 0.003170
## ind2_single_methods$defined_populations_simplifiedgenetic_clusters 1.386418
## ind2_single_methods$defined_populations_simplifiedgeographic_boundaries -0.102281
## ind2_single_methods$defined_populations_simplifiedmanagement_units 0.381030
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedgenetic_clusters -0.085788
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedgeographic_boundaries -0.001195
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedmanagement_units -0.047034
## Std. Error
## (Intercept) 0.351051
## ind2_single_methods$n_extant_populations 0.006112
## ind2_single_methods$defined_populations_simplifiedgenetic_clusters 0.631502
## ind2_single_methods$defined_populations_simplifiedgeographic_boundaries 0.376434
## ind2_single_methods$defined_populations_simplifiedmanagement_units 0.576978
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedgenetic_clusters 0.112131
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedgeographic_boundaries 0.007209
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedmanagement_units 0.022699
## t value
## (Intercept) 4.291
## ind2_single_methods$n_extant_populations 0.519
## ind2_single_methods$defined_populations_simplifiedgenetic_clusters 2.195
## ind2_single_methods$defined_populations_simplifiedgeographic_boundaries -0.272
## ind2_single_methods$defined_populations_simplifiedmanagement_units 0.660
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedgenetic_clusters -0.765
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedgeographic_boundaries -0.166
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedmanagement_units -2.072
## Pr(>|t|)
## (Intercept) 2.47e-05
## ind2_single_methods$n_extant_populations 0.6044
## ind2_single_methods$defined_populations_simplifiedgenetic_clusters 0.0290
## ind2_single_methods$defined_populations_simplifiedgeographic_boundaries 0.7860
## ind2_single_methods$defined_populations_simplifiedmanagement_units 0.5096
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedgenetic_clusters 0.4449
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedgeographic_boundaries 0.8684
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedmanagement_units 0.0392
##
## (Intercept) ***
## ind2_single_methods$n_extant_populations
## ind2_single_methods$defined_populations_simplifiedgenetic_clusters *
## ind2_single_methods$defined_populations_simplifiedgeographic_boundaries
## ind2_single_methods$defined_populations_simplifiedmanagement_units
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedgenetic_clusters
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedgeographic_boundaries
## ind2_single_methods$n_extant_populations:ind2_single_methods$defined_populations_simplifiedmanagement_units *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for quasibinomial family taken to be 0.4238188)
##
## Null deviance: 121.42 on 280 degrees of freedom
## Residual deviance: 113.49 on 273 degrees of freedom
## AIC: NA
##
## Number of Fisher Scoring iterations: 5Single plot 3 panels for the effect of method to define populations on Proportion of maintained populations (indicator) and number of pops
Plot in three panels.
## plot for Proportion of maintained populations (indicator) only with n in axis labels
# sample size
sample_size <- ind2_data %>%
filter(!is.na(indicator2)) %>%
filter(n_extant_populations<500) %>%
group_by(defined_populations_nicenames) %>% summarize(num=n())
# custom axis
## new dataframe
df<-ind2_data %>%
filter(n_extant_populations<500) %>%
filter(!is.na(indicator2)) %>%
# add sampling size
left_join(sample_size) %>%
mutate(myaxis = paste0(defined_populations_nicenames, " (n= ", num, ")")) %>%
#myaxis needs levels in the same order than defined_populations_nicenames
mutate(myaxis = factor(myaxis,
levels=levels(as.factor(myaxis))[c(1,11,2:10,12)])) # reorders levels## Joining, by = "defined_populations_nicenames"## Change levels of myaxis to keep only the n
levels(df$myaxis)<-sub(".*(\\(n= \\d+\\))", "\\1", levels(df$myaxis)) # extract "(n = number)"
p2.1<- df %>%
filter(n_extant_populations<500) %>%
ggplot(aes(x=myaxis, y=indicator2, color=defined_populations_nicenames,
fill=defined_populations_nicenames)) +
geom_boxplot() + xlab("") + ylab("Proportion of maintained populations (indicator)") +
geom_jitter(size=.4, width = 0.1, color="black") +
coord_flip() +
theme_light() +
theme(panel.border = element_blank(), legend.position="none",
plot.margin = unit(c(0, 0, 0, 0), "cm")) + # this is used to decrease the space between plots)
scale_fill_manual(values=alpha(simplifiedmethods_colors, 0.3),
breaks=levels(as.factor(ind2_data$defined_populations_nicenames))) +
scale_color_manual(values=simplifiedmethods_colors,
breaks=levels(as.factor(ind2_data$defined_populations_nicenames))) +
scale_x_discrete(limits=rev) +
theme(text = element_text(size = 13))
# plot
plot_grid(p1, p2.1, p3, ncol=3, rel_widths = c(1.7,1,1), align = "h", labels=c("a)", "b)", "c)")) 
Option 2:
# panel labels
p1<-p1+ggtitle("a)")
p2.1<-p2.1+ggtitle("b)")
p3<-p3+ggtitle("c)")
# nested plot!
panel_figure <- plot_grid(
plot_grid(p1, p2.1, ncol = 2, rel_widths = c(1.5,1)), # Arranging p1 and p2 in 2 columns
p3, # Placing p3 centered below p1 and p2
ncol = 1, # Single column layout
rel_heights = c(1.3, 2) # Adjust the relative heights of rows
)
panel_figure
Indicator 1 and indicator 2 by type of range
All the following plots below consider the average of multiassessed species, so that they are shown only once.
Indicator 1 (Ne > 5000)
Indicator 1 by type of range in the entire dataset:
# get sample size by desired category
sample_size <- indicators_averaged_one %>%
filter(!is.na(indicator1_mean)) %>%
group_by(species_range) %>% summarize(num=n())
# plot
p1<-indicators_averaged_one %>%
# add sampling size
left_join(sample_size) %>%
mutate(myaxis = paste0(species_range, " (n= ", num, ")")) %>%
# plot
ggplot(aes(x=myaxis, y=indicator1_mean , fill=species_range)) +
geom_violin(width=1, linewidth = 0) +
geom_jitter(size=.5, width = 0.1) +
xlab("") + ylab("Proportion of popuations with Ne > 500") +
coord_flip() +
scale_fill_manual(breaks=c("wide_ranging", "restricted", "unknown"),
labels=c("wide ranging", "restricted", "unknown"),
values=c("#F8766D", "#00BFC4", "grey80")) +
theme_light() +
theme(panel.border = element_blank(), legend.position="none", text= element_text(size=20))## Joining, by = "species_range"p1## Warning: Removed 351 rows containing non-finite values (`stat_ydensity()`).## Warning: Groups with fewer than two data points have been dropped.## Warning: Removed 351 rows containing missing values (`geom_point()`).
Indicator 1 by country and type of range
### Duplicate dataframe to have a column with "all data" for faceting
df<-CreateAllFacet(indicators_averaged_one, "country_assessment")
# order with "all" as last
df$facet <- factor(df$facet, levels=c("Australia", "Belgium", "Colombia", "France", "Japan", "Mexico", "S. Africa", "Sweden", "US", "all"))
## plot
df %>%
# filter out "unknown" range
filter(species_range!="unknown") %>%
# plot
ggplot(aes(x=species_range, y=indicator1_mean , fill=species_range)) +
geom_violin(width=1, linewidth = 0) +
geom_jitter(size=.5, width = 0.1) +
xlab("") + ylab("Proportion of popuations with Ne > 500") +
coord_flip() +
scale_x_discrete(breaks=c("wide_ranging", "restricted"),
labels=c("wide ranging", "restricted")) +
theme_light() +
theme(panel.border = element_blank(), legend.position="none", text= element_text(size=15)) +
facet_wrap(~facet, ncol = 5) +
theme(panel.spacing = unit(1.5, "lines")) ## Warning: Removed 668 rows containing non-finite values (`stat_ydensity()`).## Warning: Removed 668 rows containing missing values (`geom_point()`).
Test the effect of range on indicator1 with country as a random
effect.
library(lme4)
## Remove unknown
data<-indicators_averaged_one %>%
filter(species_range!="unknown")
## run model with glm
m1 <- glm(data$indicator1_mean ~ data$species_range + data$country_assessment, family = "quasibinomial")
summary(m1)##
## Call:
## glm(formula = data$indicator1_mean ~ data$species_range + data$country_assessment,
## family = "quasibinomial")
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.4003 -0.7780 -0.5187 0.5355 2.1527
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -2.21326 0.36543 -6.057 2.64e-09 ***
## data$species_rangewide_ranging 1.29256 0.19893 6.498 1.89e-10 ***
## data$country_assessmentBelgium 0.09133 0.40380 0.226 0.821151
## data$country_assessmentColombia 1.17315 0.49918 2.350 0.019133 *
## data$country_assessmentFrance 1.20297 0.42432 2.835 0.004758 **
## data$country_assessmentJapan -0.77414 0.57877 -1.338 0.181614
## data$country_assessmentMexico 0.38549 0.46797 0.824 0.410457
## data$country_assessmentS. Africa 1.15057 0.41815 2.752 0.006135 **
## data$country_assessmentSweden 0.27522 0.42566 0.647 0.518195
## data$country_assessmentUS 1.43086 0.41243 3.469 0.000564 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for quasibinomial family taken to be 0.7426528)
##
## Null deviance: 498.97 on 537 degrees of freedom
## Residual deviance: 433.56 on 528 degrees of freedom
## (334 observations deleted due to missingness)
## AIC: NA
##
## Number of Fisher Scoring iterations: 5# or with lme4?
m2 <-lmer(indicator1_mean ~ species_range + (1|country_assessment), data = data)
summary(m2)## Linear mixed model fit by REML ['lmerMod']
## Formula: indicator1_mean ~ species_range + (1 | country_assessment)
## Data: data
##
## REML criterion at convergence: 480.9
##
## Scaled residuals:
## Min 1Q Median 3Q Max
## -1.4669 -0.7557 -0.3466 0.6084 2.4584
##
## Random effects:
## Groups Name Variance Std.Dev.
## country_assessment (Intercept) 0.01162 0.1078
## Residual 0.13704 0.3702
## Number of obs: 538, groups: country_assessment, 9
##
## Fixed effects:
## Estimate Std. Error t value
## (Intercept) 0.17939 0.04188 4.283
## species_rangewide_ranging 0.23319 0.03475 6.711
##
## Correlation of Fixed Effects:
## (Intr)
## spcs_rngwd_ -0.325Indicator 1 and Indicator 2 by IUCN status
Indicator 1
Indicator 1 by global IUCN in the entire dataset:
## Global IUCN
## prepare data
# add sampling size
sample_size <- indicators_averaged_one %>%
filter(!is.na(indicator1_mean)) %>%
group_by(global_IUCN) %>% summarize(num=n())
# new df
df<- indicators_averaged_one %>%
filter(!is.na(indicator1_mean)) %>%
# add sampling size
left_join(sample_size) %>%
mutate(myaxis = paste0(global_IUCN, " (n= ", num, ")"))## Joining, by = "global_IUCN"# change order of levels so that they are in the desired order
df$myaxis<-factor(df$myaxis,
#grep is used below to get the sample size, which may change depending on the data
levels=c(grep("cr", unique(df$myaxis), value = TRUE),
grep("en", unique(df$myaxis), value = TRUE),
grep("vu", unique(df$myaxis), value = TRUE),
grep("nt", unique(df$myaxis), value = TRUE),
grep("lc", unique(df$myaxis), value = TRUE),
grep("dd", unique(df$myaxis), value = TRUE),
grep("not_assessed", unique(df$myaxis), value = TRUE),
grep("unknown", unique(df$myaxis), value = TRUE)))
df$global_IUCN<-factor(df$global_IUCN, levels=c("cr", "en", "vu", "nt", "lc", "dd", "not_assessed", "unknown"))
# plot
p1<-df %>%
ggplot(aes(x=myaxis, y=indicator1 , fill=global_IUCN)) +
geom_violin(width=1, linewidth = 0) +
geom_jitter(size=.5, width = 0.1) +
xlab("") + ylab("Proportion of popuations with Ne > 500") +
coord_flip() +
scale_fill_manual(values= IUCNcolors, # iucn color codes
breaks=c(levels(df$global_IUCN))) +
theme_light() +
ggtitle("a) global Red List") +
theme(panel.border = element_blank(), legend.position="none", text= element_text(size=15))
p1## Warning: Removed 4 rows containing non-finite values (`stat_ydensity()`).## Warning: Groups with fewer than two data points have been dropped.## Warning: Removed 4 rows containing missing values (`geom_point()`).
Indicator 1 by regional IUCN in the entire dataset:
## Regional IUCN
## prepare data
# add sampling size
sample_size <- indicators_averaged_one %>%
filter(!is.na(indicator1_mean)) %>%
group_by(regional_redlist) %>% summarize(num=n())
# new df
df<- indicators_averaged_one %>%
filter(!is.na(indicator1_mean)) %>%
# add sampling size
left_join(sample_size) %>%
mutate(myaxis = paste0(regional_redlist, " (n= ", num, ")"))## Joining, by = "regional_redlist"# change order of levels so that they are in the desired order
df$myaxis<-factor(df$myaxis,
#grep is used below to get the sample size, which may change depending on the data
levels=c(grep("re", unique(df$myaxis), value = TRUE),
grep("cr", unique(df$myaxis), value = TRUE),
grep("en", unique(df$myaxis), value = TRUE),
grep("vu", unique(df$myaxis), value = TRUE),
grep("nt", unique(df$myaxis), value = TRUE),
grep("lc", unique(df$myaxis), value = TRUE),
grep("dd", unique(df$myaxis), value = TRUE),
grep("not_assessed", unique(df$myaxis), value = TRUE),
grep("unknown", unique(df$myaxis), value = TRUE)))
df$regional_redlist<-factor(df$regional_redlist, levels=c("re","cr", "en", "vu", "nt", "lc", "dd", "not_assessed", "unknown"))
# plot
p2<-df %>%
ggplot(aes(x=myaxis, y=indicator1_mean , fill=regional_redlist)) +
geom_violin(width=1, linewidth = 0) +
geom_jitter(size=.5, width = 0.1) +
xlab("") + ylab("Proportion of popuations with Ne > 500") +
coord_flip() +
scale_fill_manual(values= IUCNcolors_regional, # iucn color codes
breaks=c(levels(df$regional_redlist))) +
theme_light() +
ggtitle("b) regional Red List") +
theme(panel.border = element_blank(), legend.position="none", text= element_text(size=15))
p2## Warning: Groups with fewer than two data points have been dropped.
Both together
plot_grid(p1, p2, ncol=2)## Warning: Removed 4 rows containing non-finite values (`stat_ydensity()`).## Warning: Groups with fewer than two data points have been dropped.## Warning: Removed 4 rows containing missing values (`geom_point()`).## Warning: Groups with fewer than two data points have been dropped.
Indicator 1 by country and global IUCN
## change order of levels so that categories match with the order of colors
indicators_averaged_one$global_IUCN<-factor(indicators_averaged_one$global_IUCN, levels=c("cr", "en", "vu", "nt", "lc", "dd", "not_assessed", "unknown"))
# plot
indicators_averaged_one %>%
# plot
ggplot(aes(x=global_IUCN, y=indicator1_mean, fill=global_IUCN)) +
geom_violin(width=1, linewidth = 0) +
geom_jitter(size=.5, width = 0.1) +
xlab("") + ylab("Proportion of popuations with Ne > 500") +
coord_flip() +
scale_fill_manual(values= IUCNcolors, # iucn color codes
breaks=c(levels(indicator1$global_IUCN))) +
theme_light() +
ggtitle("global IUCN Redlist") +
theme(panel.border = element_blank(), legend.position="none", text= element_text(size=13)) +
facet_wrap(~country_assessment, ncol = 3) +
theme(panel.spacing = unit(1.5, "lines"))## Warning: Removed 351 rows containing non-finite values (`stat_ydensity()`).## Warning: Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.## Warning: Removed 351 rows containing missing values (`geom_point()`).
Indicator1 by regional IUCN Redlist, excluding US and Mexico becasue they don’t have a regional IUCN redlist.
## change order of levels so that categories match with the order of colors
indicators_averaged_one$regional_redlist<-factor(indicators_averaged_one$regional_redlist, levels=c("re","cr", "en", "vu", "nt", "lc", "dd", "not_assessed", "unknown"))
# plot
indicators_averaged_one %>%
# filter US and Mx
filter(country_assessment!="Mexico", country_assessment!="US") %>%
# plot
ggplot(aes(x=regional_redlist, y=indicator1_mean, fill=regional_redlist)) +
geom_violin(width=1, linewidth = 0) +
geom_jitter(size=.5, width = 0.1) +
xlab("") + ylab("Proportion of popuations with Ne > 500") +
coord_flip() +
scale_fill_manual(values= IUCNcolors_regional, # iucn color codes
breaks=c(levels(indicator1$regional_redlist))) +
theme_light() +
ggtitle("regional IUCN Redlist") +
theme(panel.border = element_blank(), legend.position="none", text= element_text(size=15)) +
facet_wrap(~country_assessment, ncol = 4) +
theme(panel.spacing = unit(1.5, "lines"))## Warning: Removed 213 rows containing non-finite values (`stat_ydensity()`).## Warning: Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.
## Groups with fewer than two data points have been dropped.## Warning: Removed 213 rows containing missing values (`geom_point()`).
Values of indicator 1 and indicator 2 for multiassessed species
#subset only with taxa assessed multiple times:
only_multi<-indicators_full %>%
filter(multiassessment=="multiassessment") First, check how indicator 1 changes across the multiassessments.
p1<-only_multi %>%
# Keep rows with different values in indicator1 within each taxon group
group_by(taxon) %>%
filter(n_distinct(indicator1) > 1) %>%
# plot
ggplot(aes(x=taxon, y=indicator1)) +
geom_line(colour="darkgrey") +
geom_point(aes(color=country_assessment)) +
xlab("") + ylab("Proportion of popuations with Ne > 500") +
labs(color="country") +
ylim(0, 1)+
coord_flip() +
theme_light() +
theme(panel.border = element_blank(), legend.position="right", text= element_text(size=13))
p1## Warning: Removed 9 rows containing missing values (`geom_line()`).## Warning: Removed 10 rows containing missing values (`geom_point()`).
Now check how Proportion of maintained populations (indicator 2) changes across the multiassessments.
p2<-only_multi %>%
# Keep rows with different values in indicator1 within each taxon group
group_by(taxon) %>%
filter(n_distinct(indicator2) > 1) %>%
ggplot(aes(x=taxon, y=indicator2)) +
geom_line(colour="darkgrey") +
geom_point(aes(color=country_assessment)) +
scale_color_manual(values= scales::hue_pal()(4)[2:4]) + # last 3 colors to make them the same than the other plot
xlab("") + ylab("Proportion of populations maintained ") +
labs(color="country") +
coord_flip() +
theme_light() +
theme(panel.border = element_blank(), legend.position="right", text= element_text(size=13))
p2## Warning: Removed 6 rows containing missing values (`geom_line()`).## Warning: Removed 6 rows containing missing values (`geom_point()`).
Plot together:
plot_grid(p2, p1,
rel_heights = c(1.3, 0.9),
ncol=1, labels=c("a)", "b)")) ## Warning: Removed 6 rows containing missing values (`geom_line()`).## Warning: Removed 6 rows containing missing values (`geom_point()`).## Warning: Removed 9 rows containing missing values (`geom_line()`).## Warning: Removed 10 rows containing missing values (`geom_point()`).
Indicator 3 (number of species with genetic diversity monitoring)
Indicator 3 refers to the number (count) of taxa by country in which genetic monitoring is occurring. This is stored in the variable temp_gen_monitoring as a “yes/no” answer for each taxon.
indicator3Plot by global IUCN redlist status
# desired order of levels
indicators_full$global_IUCN<-factor(as.factor(indicators_full$global_IUCN), levels=c("cr", "en", "vu", "nt", "lc", "dd", "not_assessed", "unknown"))
## plot
indicators_full %>%
# keep only one record if the taxon was assessed more than once within the country
select(country_assessment, taxon, temp_gen_monitoring, global_IUCN) %>%
filter(!duplicated(.)) %>%
# count "yes" in tem_gen_monitoring by country
filter(temp_gen_monitoring=="yes") %>%
ggplot(aes(x=country_assessment, fill=global_IUCN)) +
geom_bar() +
xlab("") + ylab("Number of taxa with temporal genetic diversity monitoring") +
scale_fill_manual(values= IUCNcolors, # iucn color codes
breaks=levels(as.factor(indicators_full$global_IUCN))) +
theme_light()
Relatively few taxa have genetic monitoring, but many have some sort of genetic study. Let’s check that with a Sankey Plot:
# first subset the ind3_data keeping only taxa assessed a single time, plust the first record of those assessed multiple times.
ind3_data_firstmulti<-ind3_data[!duplicated(cbind(ind3_data$taxon, ind3_data$country_assessment)), ]
# transform data to how ggsankey wants it
df <- ind3_data_firstmulti %>%
make_long(country_assessment, temp_gen_monitoring, gen_studies)
# plot
ggplot(df, aes(x = x,
next_x = next_x,
node = node,
next_node = next_node,
fill = factor(node),
label = node)) +
geom_sankey(flow.alpha = 0.5,
show.legend = FALSE) +
geom_sankey_label(size = 2.5, color = "black", fill = "white") +
theme_sankey(base_size = 10) +
# manually set flow fill according to desired color
# countries
scale_fill_manual(values=c(scales::hue_pal()(length(unique(ind3_data_firstmulti$country_assessment))),
# traffic light for monitoring
c("darkolivegreen", "brown3", "darkgrey"),
# nice soft colors for gen_studies
c("grey50", "grey35", "grey50", "brown3")),
breaks=c(unique(ind3_data_firstmulti$country_assessment),
unique(ind3_data_firstmulti$temp_gen_monitoring),
unique(ind3_data_firstmulti$gen_studies))) +
xlab("")## Warning: Removed 2 rows containing missing values (`geom_label()`).
table(ind3_data_firstmulti$gen_studies)##
## no phylo phylo_pop pop
## 386 185 239 94Count data:
ind3_data %>%
# keep only one record if the taxon was assessed more than once within the country
select(country_assessment, taxon, gen_studies, temp_gen_monitoring) %>%
filter(!duplicated(.)) %>%
group_by(country_assessment, temp_gen_monitoring, gen_studies) %>%
summarise(n_studies=n())## `summarise()` has grouped output by 'country_assessment',
## 'temp_gen_monitoring'. You can override using the `.groups` argument.How many genetic studies ara available by country for species without temporal genetic diversity monitoring?
## plot
indicators_full %>%
# keep only one record if the taxon was assessed more than once within the country
select(country_assessment, taxon, temp_gen_monitoring, gen_studies) %>%
filter(!duplicated(.)) %>%
# keep only taxa without gen div monitoring
filter(temp_gen_monitoring=="no")%>%
ggplot(aes(x=country_assessment, fill=gen_studies)) +
geom_bar() +
scale_fill_manual(values=c("grey80", scales::hue_pal()(3)))+
xlab("") +
theme_light()